home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1997 July
/
EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso
/
earcd
/
biz
/
swood
/
fw_mef.lha
/
FW_MEf
/
Meinfügen.fwrexx
< prev
next >
Wrap
Text File
|
1997-04-08
|
4KB
|
190 lines
/* Optimized with RexxOpt 1.7 */
R='0A'X
Dre=0
Sei=0
Address='FinalW'
Options results
STATUS PORTNAME
FW=result
address=FW
SIGNAL ON BREAK_C
SIGNAL ON SYNTAX
'ShowMessage 2 0 "Mehrfach Einfügen V1.5 - 08.04.97" " Neu: Das Shareware-Paket" "Info im Mehrfach-Einfügen-Guide" "(-:" "Ok" ":-)"'
GetDocItemPrefs Decimal
Punkt=Result
If Punkt="Comma" then DocItemPrefs Decimal Period
GraphicTool
nr=1
CurrentObject
ObjectId=Result
IF ObjectId=0 THEN;do
'ShowMessage 1 1 "Makro: Mehrfach Einfügen" "Kein Grafikobjekt ausgewählt..." "" "Okay" "" ""'
Call BREAK_C
End
Objekt.0=nr;Objekt.nr=ObjectID
FirstObject Selected
ID=result
Call Zaehlen
Do While 1
NextObject ID Selected
ID=result
If ID=0 then Leave
Call Zaehlen
End
If Objekt.0=1 then;do
gruppe=false
end
else gruppe=true
Do a=2 to Objekt.0
SelectObject Objekt.a MULTIPLE
End
SelectObject Objekt.1 MULTIPLE
STATUS View
Zoom=result
STATUS Pages
Seiten=result
STATUS Page
Seite=result
If Gruppe=true then Group
Copy
IF RC=0 THEN;do
CurrentObject
ObjectID=result
GetObjectCoords ObjectID
Parse var result Seite x y w h
wl=w
hl=h
GetObjectRotation ObjectID
Dreh=result
GetObjectType ObjectID
Typ=result
If Typ=2|Typ=3 then;do
If Seite~=1 then;do
'ShowMessage 1 1 "FW hat Probleme mit Linien außerhalb" "der Seite 1... " "" "Okay" "" ""'
Call BREAK_C
End
End
If Gruppe=true then Ungroup
'ShowMessage 1 0 "Wie soll die Bildschirmausgabe erfolgen?" "" "" "Normal" "Speed" ""'
ba=result
IF ba=2 THEN;DO
status WINDOW
parse VAR result links oben width height minwidth minheight maxwidth maxheight
sizewindow minwidth minheight
End
Do While 1
Result="ß"
RequestText '"Mehrfach Einfügen" "Anzahl der Kopien" ""'
Anzahl=Result
If Anzahl="ß" then call Ende1
If Anzahl=""|Anzahl=0 then call Ende
If Datatype(Anzahl,'W')=1 then leave
else call oops
End
Do while 1
Result="ß"
RequestText '"Mehrfach Einfügen" "Horizontale Verschiebung in cm" ""'
Hor=Result
If Hor="ß" then call Ende1
If Hor="" then Hor=0
If Datatype(Hor,'N')=1 then leave
else call oops1
End
Do while 1
Result="ß"
RequestText '"Mehrfach Einfügen" "Vertikale Verschiebung in cm" ""'
Ver=Result
If Ver="ß" then call Ende1
If Ver="" then Ver=0
If Datatype(Ver,'N')=1 then leave
else call oops1
End
If Typ~=2&Typ~=3 then;do
Do while 1
Result="ß"
RequestText '"Mehrfach Einfügen" "Drehung in Grad" ""'
Dre=Result
If Dre="ß" then call Ende1
If Dre="" then Dre=0
If Datatype(Dre,'W')=1 then leave
else call oops
End
Do While 1
Result="ß"
RequestText '"Mehrfach Einfügen" "Auf welche Seite? 0=dieselbe Seite" ""'
Sei=Result
If Sei="ß" then call Ende1
If Sei=""|Sei=0 then Sei=Seite
If Datatype(Sei,'W')=1 then leave
else call oops
End
end
s=Sei-Seiten
Do a=1 to s
InsertPageBreak
End
If ba=2 then View 20
Do i=1 TO Anzahl
Paste
CurrentObject
ObjectID=Result
a=x+(Hor*i)
b=y+(Ver*i)
Winkel=Dreh+Dre*i
If Typ=2|Typ=3 then;do
w=wl+(Hor*i)
h=hl+(Ver*i)
Sei=Seite
End
SetObjectCoords ObjectID Sei a b w h
SetObjectRotation ObjectID Winkel
If Gruppe=true then Ungroup
End
End
Redraw
Call WH
'ShowMessage 2 1 "Vielen Dank für die Benutzung." "© Heiko Schröder" "http://yi.com/home/SchroederHeiko" "@-`-" "Bitte" ":-))"'
Exit
ENDE:
Call WH
'ShowMessage 1 1 "Falsche Anzahl an Kopien..." "A B B R U C H" "" "Okay" "" ""'
EXIT
ENDE1:
Call WH
'ShowMessage 1 1 "Sie haben abgebrochen..." "© Heiko Schröder" "http://yi.com/home/SchroederHeiko" "Okay" "" ""'
EXIT
SYNTAX:
Call WH
'ShowMessage 1 1 "Es ist ein Fehler aufgetreten." "Nähere Info in Datei «Ram:Fehler«" "" "Was?" "Gibts nicht!" "Sofort melden"'
address "REXX"
Open("F","Ram:Fehler","W")
writeln("F","ACHTUNG! FW_MEf V1.4 Makro-Fehler"||R)
writeln("F",'Fehler in Zeile' SIGL ':' ERRORTEXT(RC)||R)
writeln("F",'Bitte informieren Sie den Autor unter s93324@fh-telekom-leipzig.de')
Close("F")
EXIT
BREAK_C:
Call WH
'ShowMessage 1 1 "Makro-Abbruch..." "" "" "Ich weiß..." "" ""'
EXIT
WH:
If ba=2 then;do
GoToPage Sei
View Zoom
sizewindow width height
End
If Punkt="Comma" then DocItemPrefs DECIMAL Comma
Return
Zaehlen:
If ID~=Objekt.1 then;do
nr=nr+1
Objekt.0=nr;Objekt.nr=ID
End
Return
oops:
'ShowMessage 1 1 "Falsche Eingabe!" "Bitte ganzzahlige Eingabe!" "" "Okay" "" ""'
return
oops1:
'ShowMessage 1 1 "Falsche Eingabe!" "Bitte numerische Eingabe mit (.) !" "" "Okay" "" ""'
return